home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Oberon
/
source
/
Library
/
Lists.mod
< prev
next >
Wrap
Text File
|
1995-06-29
|
7KB
|
306 lines
(***************************************************************************
$RCSfile: Lists.mod $
Description: Doubly-linked lists similar to Exec lists
Created by: fjc (Frank Copeland)
$Revision: 1.11 $
$Author: fjc $
$Date: 1995/06/04 23:22:41 $
Copyright © 1994-1995, Frank Copeland.
This file is part of the Oberon-A Library.
See Oberon-A.doc for conditions of use and distribution.
***************************************************************************)
MODULE Lists;
IMPORT SYS := SYSTEM, Errors, Strings, Strings2;
TYPE
(* A simple doubly linked node *)
NodePtr * = POINTER TO Node;
Node * = RECORD
succ * : NodePtr;
pred * : NodePtr;
END; (* Node *)
(* An named node. *)
NameNodePtr * = POINTER TO NameNode;
NameNode * = RECORD (Node)
name - : POINTER TO ARRAY OF CHAR;
END; (* NameNode *)
(* An node with a key *)
KeyNodePtr * = POINTER TO KeyNode;
KeyNode * = RECORD (Node)
key * : LONGINT;
END; (* KeyNode *)
(* A list header *)
ListPtr * = POINTER TO List;
List * = RECORD
head * : NodePtr;
tail * : NodePtr;
END; (* List *)
(* A header for a list of NameNodes *)
NameListPtr * = POINTER TO NameList;
NameList * = RECORD (List) END;
(* A header for a list of KeyNodes *)
KeyListPtr * = POINTER TO KeyList;
KeyList * = RECORD (List) END;
(* --- NameNode procedures ----------------------------------------------- *)
(*------------------------------------*)
PROCEDURE (VAR node : NameNode) Name * (name : ARRAY OF CHAR);
<*$CopyArrays-*>
BEGIN (* Name *)
NEW (node.name, Strings.Length (name) + 1);
COPY (name, node.name^)
END Name;
(* --- List procedures -------------------------------------------------- *)
(*------------------------------------*)
PROCEDURE (VAR list : List) NewList*;
BEGIN (* NewList *)
list.head := NIL; list.tail := NIL
END NewList;
(*------------------------------------*)
PROCEDURE (VAR list : List) AddHead * (node : NodePtr);
BEGIN (* AddHead *)
node.succ := list.head; node.pred := NIL;
IF list.head # NIL THEN list.head.pred := node END;
list.head := node;
IF list.tail = NIL THEN list.tail := node END
END AddHead;
(*------------------------------------*)
PROCEDURE (VAR list : List) AddTail * (node : NodePtr);
BEGIN (* AddTail *)
node.succ := NIL; node.pred := list.tail;
IF list.tail # NIL THEN list.tail.succ := node END;
list.tail := node;
IF list.head = NIL THEN list.head := node END
END AddTail;
(*------------------------------------*)
PROCEDURE (VAR list : List) Insert * (node, prevNode : NodePtr);
BEGIN (* Insert *)
IF prevNode = NIL THEN list.AddHead (node)
ELSIF prevNode = list.tail THEN list.AddTail (node)
ELSE
node.succ := prevNode.succ;
IF node.succ # NIL THEN node.succ.pred := node END;
node.pred := prevNode; prevNode.succ := node
END
END Insert;
(*------------------------------------*)
PROCEDURE (VAR list : List) IsListEmpty * () : BOOLEAN;
BEGIN (* IsListEmpty *)
RETURN (list.head = NIL)
END IsListEmpty;
(*------------------------------------*)
PROCEDURE (VAR list : List) RemHead * () : NodePtr;
VAR node : NodePtr;
BEGIN (* RemHead *)
node := list.head;
IF node # NIL THEN
list.head := node.succ;
IF list.tail = node THEN list.tail := NIL END;
node.pred := NIL; node.succ := NIL
END;
RETURN node
END RemHead;
(*------------------------------------*)
PROCEDURE (VAR list : List) RemTail * () : NodePtr;
VAR node : NodePtr;
BEGIN (* RemTail *)
node := list.tail;
IF node # NIL THEN
list.tail := node.pred;
IF list.head = node THEN list.head := NIL END;
node.pred := NIL; node.succ := NIL
END;
RETURN node
END RemTail;
(*------------------------------------*)
PROCEDURE (VAR list : List) Remove * (node : NodePtr);
BEGIN (* Remove *)
IF node.succ # NIL THEN node.succ.pred := node.pred END;
IF node.pred # NIL THEN node.pred.succ := node.succ END;
IF list.head = node THEN list.head := node.succ END;
IF list.tail = node THEN list.tail := node.pred END;
node.succ := NIL; node.pred := NIL
END Remove;
(*------------------------------------*)
PROCEDURE (VAR list : List) Enqueue * (node : NodePtr);
BEGIN (* Enqueue *)
HALT (Errors.notImplemented)
END Enqueue;
(* --- List procedures requiring NameNodes ------------------------------- *)
(*------------------------------------*)
PROCEDURE (VAR list : NameList) AddHead * (node : NodePtr);
BEGIN (* AddHead *)
WITH node : NameNodePtr DO list.AddHead^ (node) END
END AddHead;
(*------------------------------------*)
PROCEDURE (VAR list : NameList) AddTail * (node : NodePtr);
BEGIN (* AddTail *)
WITH node : NameNodePtr DO list.AddTail^ (node) END
END AddTail;
(*------------------------------------*)
PROCEDURE (VAR list : NameList) Insert * (node, prevNode : NodePtr);
BEGIN (* Insert *)
WITH node : NameNodePtr DO list.Insert^ (node, prevNode) END
END Insert;
(*------------------------------------*)
PROCEDURE (VAR list : NameList) Enqueue * (node : NodePtr);
VAR next : NodePtr;
BEGIN (* Enqueue *)
WITH node : NameNodePtr DO
next := list.head;
WHILE (next # NIL) & (next(NameNodePtr).name^ <= node.name^) DO
next := next.succ
END;
IF next = NIL THEN list.AddTail (node)
ELSE list.Insert (node, next.pred)
END
END;
END Enqueue;
(*------------------------------------*)
PROCEDURE (VAR list : NameList) Find *
(name : ARRAY OF CHAR) : NodePtr;
VAR next : NodePtr;
<*$CopyArrays-*>
BEGIN (* Find *)
next := list.head;
WHILE (next # NIL) & (next(NameNodePtr).name^ # name) DO
next := next.succ
END;
RETURN next
END Find;
(*------------------------------------*)
PROCEDURE (VAR list : NameList) FindCap *
(name : ARRAY OF CHAR) : NodePtr;
VAR next : NodePtr;
<*$CopyArrays-*>
BEGIN (* FindCap *)
next := list.head;
WHILE
(next # NIL) & (Strings2.CompareCAP (next(NameNodePtr).name^, name) # 0)
DO
next := next.succ
END;
RETURN next
END FindCap;
(* --- List procedures requiring KeyNodes ------------------------------- *)
(*------------------------------------*)
PROCEDURE (VAR list : KeyList) AddHead * (node : NodePtr);
BEGIN (* AddHead *)
WITH node : KeyNodePtr DO list.AddHead^ (node) END
END AddHead;
(*------------------------------------*)
PROCEDURE (VAR list : KeyList) AddTail * (node : NodePtr);
BEGIN (* AddTail *)
WITH node : KeyNodePtr DO list.AddTail^ (node) END
END AddTail;
(*------------------------------------*)
PROCEDURE (VAR list : KeyList) Insert * (node, prevNode : NodePtr);
BEGIN (* Insert *)
WITH node : KeyNodePtr DO list.Insert^ (node, prevNode) END
END Insert;
(*------------------------------------*)
PROCEDURE (VAR list : KeyList) Enqueue * (node : NodePtr);
VAR next : NodePtr;
BEGIN (* Enqueue *)
WITH node : KeyNodePtr DO
next := list.head;
WHILE (next # NIL) & (next(KeyNodePtr).key <= node.key) DO
next := next.succ
END;
IF next = NIL THEN list.AddTail (node)
ELSE list.Insert (node, next.pred)
END
END;
END Enqueue;
(*------------------------------------*)
PROCEDURE (VAR list : KeyList) Find * (key : LONGINT) : NodePtr;
VAR next : NodePtr;
<*$CopyArrays-*>
BEGIN (* Find *)
next := list.head;
WHILE (next # NIL) & (next(KeyNodePtr).key # key) DO
next := next.succ
END;
RETURN next
END Find;
END Lists.